home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 0292.ZIP / TRACKIT.ARC / TRACKPRO.PRG < prev    next >
Text File  |  1985-12-21  |  4KB  |  149 lines
  1. * FILE NAME           TRACKPRO.PRG
  2. * MAIN PROGRAM        TRACK_IT.PRG
  3. * PROGRAMMER          DAVID IRWIN
  4. * DATE WRITTEN        12/15/84
  5. * LAST UPDATE         01/08/85
  6. *
  7. *
  8. * This is the procedure file for the TRACK_IT system called by
  9. * track_it.prg
  10. *
  11. *
  12. * Mainmenu clears the screen, paints the main menu,
  13. * and gets and validates the menu choice.
  14.  
  15. * Use SET COLOR for color monitors only unless otherwise noted.
  16.  
  17. PROCEDURE mainmenu
  18. CLEAR
  19. TEXT
  20.  
  21.                           + + + TRACK-IT PLUS + + +
  22.  
  23.                           SEARCH FUNCTION CRITERIA
  24.  
  25.                         [F2]  Last Name
  26.                         [F3]  Company Name
  27.                         [F4]  Product Name
  28.                         [F5]  Date
  29.                         [F6]  Status
  30.  
  31.  
  32.                           ADDITIONAL FUNCTIONS
  33.  
  34.                         [F7]  Add New Records
  35.                         [F8]  Do a dBASE III Command
  36.                         [F9]  Quit
  37.                        [F10]  Use Personal list
  38. ENDTEXT
  39. choice = " "
  40. DO WHILE val(choice) < 2 .OR. val(choice) > 10
  41.    choice = " "
  42.    @ 20,25 SAY "Your Choice ? " GET choice
  43.    READ
  44. ENDDO WHILE val(choice) < 2 .OR. val(choice) > 10
  45. CLEAR
  46. RETURN
  47. **************************************************
  48. PROCEDURE if_blank
  49. IF string = " "
  50.    looper = .T.
  51. ELSE
  52.    SEEK upper(trim(string))
  53. ENDIF # blanks
  54. RETURN
  55. ***************************************************
  56. PROCEDURE tstring
  57. string = space(tblanks)
  58. center = 40 - int(len(tseek) + 9 + tblanks)/2
  59. @ 10,center SAY tseek + " to Find " GET string
  60. READ
  61. RETURN
  62. **************************************************
  63. PROCEDURE tscreen
  64. TEXT
  65.  
  66.  
  67.                First name
  68.                Last name
  69.  
  70.                Product
  71.  
  72.                Company name
  73.  
  74.                Address
  75.  
  76.                City                          State      Zip
  77.  
  78.                Phone
  79.  
  80.           = = = = = = = = = = = = Update Area = = = = = = = = = = =
  81.  
  82.                Status
  83.  
  84.                Last contact
  85.  
  86.                Next Call
  87. ENDTEXT
  88. RETURN
  89. ************************************************
  90. PROCEDURE tsays
  91. IF action # "U"
  92.    * SET color TO g/b,w/r,s
  93.    @ 20,30 SAY fname
  94.    @ 03,30 SAY lname
  95.    @ 05,30 SAY product
  96.    @ 07,30 SAY company
  97.    @ 09,30 SAY address
  98.    @ 11,30 SAY city
  99.    @ 11,52 SAY state
  100.    @ 11,61 SAY zip
  101.    @ 13,30 SAY phone
  102. ENDIF action # "U"
  103. * SET color TO~ g/b,w/gr,
  104. @ 17,30 SAY status
  105. @ 19,30 SAY date_last
  106. @ 21,30 SAY date_next
  107. * SET color TO gr/b,w/r,
  108. RETURN
  109. *************************************************
  110. PROCEDURE tgets
  111. IF action # "U"
  112.    @ 02,30 GET fname PICTURE "!XXXXXXXXX"
  113.    @ 03,30 GET lname PICTURE "!XXXXXXXXXXXXXXXXXXX"
  114.    @ 05,30 GET product PICTURE "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  115.    @ 07,30 GET company PICTURE "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  116.    @ 09,30 GET address PICTURE "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
  117.    @ 11,30 GET city PICTURE "!XXXXXXXXXXXXXX"
  118.    @ 11,52 GET state PICTURE "!!"
  119.    @ 11,61 GET zip PICTURE "99999-9999"
  120.    @ 13,30 GET phone PICTURE "9-999-999-9999"
  121. ENDIF action # "U"
  122. @ 17,30 GET status PICTURE "!"
  123. @ 19,30 GET date_last
  124. @ 21,30 GET date_next
  125. READ
  126. RETURN
  127. ******************************************************
  128. PROCEDURE contline
  129. * SET color TO r/w,w/r,
  130. @ 23,13 SAY "(N)ext  (P)revious  (U)udate  (E)dit  (M)emo  (D)one";
  131.         GET action PICTURE "!"
  132. * SET color TO gr/b,w/r,
  133. READ
  134. RETURN
  135. *****************************************************
  136. PROCEDURE exitmenu
  137. CLEAR
  138. @  8,34 SAY "Exit Menu:"
  139. @ 10,28 SAY "(1) Quit to dBASE III"
  140. @ 12,28 SAY "(2) Quit to DOS"
  141. @ 14,28 SAY "(3) Return to Program"
  142. STORE " " TO choice2
  143. DO WHILE choice2 < "1" .OR. choice2 > "3"
  144.    @ 16,32 SAY "Your choice ? " GET choice2
  145.    STORE " " TO choice2
  146.    READ
  147. ENDDO WHILE choice2 < "1" .OR. choice2 > "3"
  148. RETURN
  149.